perm filename REVAL3.LBK[F75,JMC] blob sn#191109 filedate 1975-12-10 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP ALLFNS
00400	 (NIL OEV REV1 REV COUNT SUBB ELEM OEVAL REVAL1 REVAL PRUP X1 X2 X3 X4 X5)
00500	VALUE)
00600	
00700	(DEFPROP OEV
00800	 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL U V) COUNT)) (SETQ COUNT 0)))
00900	EXPR)
01000	
01100	(DEFPROP REV1
01200	 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL1 U V) COUNT)) (SETQ COUNT 0)))
01300	EXPR)
01400	
01500	(DEFPROP REV
01600	 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL U V) COUNT)) (SETQ COUNT 0)))
01700	EXPR)
01800	
01900	(DEFPROP COUNT
02000	 (NIL . 4)
02100	VALUE)
02200	
02300	(DEFPROP SUBB
02400	 (LAMBDA (X Y Z) (IF (ATOM Z) (IF (EQ Y Z) X Z) (CONS (SUBB X Y (CAR Z)) (SUBB X Y (CDR Z)))))
02500	EXPR)
02600	
02700	(DEFPROP ELEM
02800	 (NIL ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR)
02900	VALUE)
03000	
03100	(DEFPROP OEVAL
03200	 (LAMBDA(E A)
03300	  ((LAMBDA(V)
03400	    (COND ((ATOM E) (CDR (ASSOC E A)))
03500		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
03600		  ((EQ (CAR E) (QUOTE IF)) (COND ((OEVAL (CADR E) A) (OEVAL (CADDR E) A)) (T (OEVAL (CADDDR E) A))))
03700		  ((MEMBER (CAR E) ELEM)
03800		   (EVAL
03900		    (CONS (CAR E)
04000			  (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (OEVAL W A))))(CDR E)))))
04100		  (T
04200	((LAMBDA (Z) (OEVAL (CADDR Z) (APPEND (PRUP (CADR Z)
04300	(MAPCAR (FUNCTION (LAMBDA (W) (OEVAL W A))) (CDR E))) A)))
04400	(GET (CAR E) (QUOTE EXPR))))
04500	))
04600	   (SETQ COUNT (ADD1 COUNT))))
04700	EXPR)
04800	
04900	(DEFPROP REVAL1
05000	 (LAMBDA(E A)
05100	  ((LAMBDA(V)
05200	    (COND ((ATOM E) ((LAMBDA (W) (REVAL1 (CAR W) (CADR W))) (CDR (ASSOC E A))))
05300		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
05400		  ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL1 (CADR E) A) (REVAL1 (CADDR E) A)) (T (REVAL1 (CADDDR E) A))))
05500		  ((MEMBER (CAR E) ELEM)
05600		   (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL1 W A)))) (CDR E)))))
05700		  (T
05800		   ((LAMBDA(W)
05900		     (REVAL1 (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
06000		    (GET (CAR E) (QUOTE EXPR))))))
06100	   (SETQ COUNT (ADD1 COUNT))))
06200	EXPR)
06300	
06400	(DEFPROP REVAL
06500	 (LAMBDA(E A)
06600	  ((LAMBDA(V)
06700	    (COND ((ATOM E)
06800		   ((LAMBDA(W)
06900		     ((LAMBDA (Z) ((LAMBDA (U) Z) (RPLACD W (LIST (LIST (QUOTE QUOTE) Z) NIL))))
07000		      (REVAL (CADR W) (CADDR W))))
07100		    (ASSOC E A)))
07200		  ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
07300		  ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A)) (T (REVAL (CADDDR E) A))))
07400		  ((MEMBER (CAR E) ELEM)
07500		   (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL W A)))) (CDR E)))))
07600		  (T
07700		   ((LAMBDA(W)
07800		     (REVAL (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
07900		    (GET (CAR E) (QUOTE EXPR))))))
08000	   (SETQ COUNT (ADD1 COUNT))))
08100	EXPR)
08200	
08300	(DEFPROP PRUP
08400	 (LAMBDA (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
08500	EXPR)
08600	
08700	(DEFPROP X1
08800	 (NIL (U (QUOTE (A B)) NIL) (V (QUOTE C) NIL) (W (QUOTE (C . C)) NIL))
08900	VALUE)
09000	
09100	(DEFPROP X2
09200	 (NIL (U A B) (V . C) (W C . C))
09300	VALUE)